Developer CD Series 1994 November: Tool Chest/Dev.CD Nov 94.toast/Sample Code/Snippets/Toolbox/BigScrolling/Sample.p

Text File | 1992-12-01 | 20.5 KB | 615 lines | [TEXT/PJMM]

{    This file has been processed by The THINK Pascal Source Converter, v1.1.2.    }

{------------------------------------------------------------------------------}


{$I-}
program Sample;   {    Segmentation strategy:}

uses
    Traps, BigScrolling;
const {}

    kNoEvents = 0; {no events mask}
    kMinHeap = 21 * 1024;      {1.01 - kMinSpace - This is the minimum result from PurgeSpace, when called}
       {     at initialization time, for the application to run. This number acts}
     {      as a double-check to insure that there really is enough memory for the}
         {      application to run, including what has been taken up already by}
     {      pre-loaded resources, the scrap, code, and other sundry memory blocks.}
    kMinSpace = 8 * 1024;  {kExtremeNeg and kExtremePos are used to set up wide open rectangles and regions.}
    kExtremeNeg = -32768;
    kExtremePos = 32767 - 1; {required for old region bug}

 {The following constants are all resource IDs, corresponding to resources in Sample.r.}
    rMenuBar = 128; {application's menu bar}
    rAboutAlert = 128; {about alert}
    rUserAlert = 129; {error user alert}

 {The following constants are used to identify menus and their items. The menu IDs}
 {      have an "m" prefix and the item numbers within each menu have an "i" prefix.}
    mApple = 128; {Apple menu}
    iAbout = 1;
    mFile = 129; {File menu}
    iQuit = 1;
    mEdit = 130; {Edit menu}
    iUndo = 1;
    iCut = 3;
    iCopy = 4;
    iPaste = 5;
    iClear = 6;  {1.01 - kDITop and kDILeft are used to locate the Disk Initialization dialogs.}
    kDITop = $0050;
    kDILeft = $0070;
var
       {GInBackground is maintained by our osEvent handling routines. Any part of}
 {      the program can check it to find out if it is currently in the background.}
    gInBackground: BOOLEAN; {maintained by Initialize and DoEvent}
    window: WindowPtr;
    cursorRgn: RgnHandle;  { cursorRgn contains a copy of the last mouseRgn we passed to WaitNextEvent}

{$S Main}

function IsDAWindow (window: WindowPtr): BOOLEAN;

    {Check if a window belongs to a desk accessory.}

    begin
        if window = nil then
            IsDAWindow := FALSE
        else {DA windows have negative windowKinds}
            IsDAWindow := (WindowPeek(window)^.windowKind < 0);
    end; {IsDAWindow}

    {$S Main}

function IsAppWindow (window: WindowPtr): BOOLEAN;

    {Check to see if a window belongs to the application. If the window pointer}
    { passed was NIL, then it could not be an application window. WindowKinds}
    { that are negative belong to the system and windowKinds less than userKind}
    { are reserved by Apple except for windowKinds equal to dialogKind, which}
    { mean it is a dialog.}
    { 1.02 - In order to reduce the chance of accidentally treating some window}
 { as an AppWindow that shouldn't be, we'll only return true if the windowkind}
    { is userKind. If you add different kinds of windows to Sample you'll need}
    { to change how this all works.}

    begin
        if window = nil then
            IsAppWindow := FALSE
        else {application windows have windowKinds = userKind (8)}
            with WindowPeek(window)^ do
                IsAppWindow := (windowKind = userKind);
    end; {IsAppWindow}

    {$S Main}

{$Z+}
 {for trafficlights.p}

procedure AlertUser;

{Display an alert that tells the user an error occurred, then exit the program.}
{ This routine is used as an ultimate bail-out for serious errors that prohibit}
{ the continuation of the application. Errors that do not require the termination}
{ of the application should be handled in a different manner. Error checking and}
{ reporting has a place even in the simplest application. For simplicity, the alert}
{ displayed here only says that an error occurred, but not what it was. There are}
    { various methods available for being more specific.}

    var
        itemHit: integer;

    begin
        SetCursor(arrow);
        itemHit := Alert(rUserAlert, nil);
        ExitToShell;
    end; {AlertUser}

    {$S Main}

function DoCloseWindow (window: WindowPtr): BOOLEAN;

    {Close a window.}

    {1.01 - At this point, if there was a document associated with a}
    { window, you could do any document saving processing if it is 'dirty'.}
    { DoCloseWindow would return TRUE if the window actually closes, i.e.,}
    { the user does not cancel from a save dialog. This result is handy when}
    { the user quits an application, but then cancels a save of a document}
    { associated with a window. We also added code to close the application}
  { window since otherwise, the termination routines would never stop looping,}
    { waiting for FrontWindow to return NIL.}

    begin
        DoCloseWindow := TRUE;
        if IsDAWindow(window) then
            begin
                CloseDeskAcc(WindowPeek(window)^.windowKind);
            end
        else if IsAppWindow(window) then
            begin
                CloseAppWindow(window);
            end
    end; {DoCloseWindow}

    {$S Initialize}

procedure Initialize;

    {Set up the whole world, including global variables, Toolbox managers,}
    { and menus. We also create our one application window at this time.}

    { If a failure occurs here, we will consider that the application is in such}
    { bad shape that we should just exit. Your error handling may differ, but}
    { the checks should still be made.}


    var
        menuBar: Handle;
        window: WindowPtr;
        ignoreError: OSErr;
        total, contig: LongInt;
        ignoreResult: BOOLEAN;
        event: EventRecord;
        count: integer;

    begin
        gInBackground := FALSE;

        InitGraf(@thePort);
        InitFonts;
        InitWindows;
        InitMenus;
        TEInit;
        InitDialogs(nil);
        InitCursor;

{1.01 - We used to make a check for memory at this point by examining ApplLimit,}
{      ApplicZone, and StackSpace and comparing that to the minimum size we told}
{      MultiFinder we needed. This did not work well because it assumed too much about}
{      the relationship between what we asked MultiFinder for and what we would actually}
{      get back, as well as how to measure it. Instead, we will use an alternate}
            {      method comprised of two steps.}

 {It is better to first check the size of the application heap against a value}
{      that you have determined is the smallest heap the application can reasonably}
{      work in. This number should be derived by examining the size of the heap that}
{      is actually provided by MultiFinder when the minimum size requested is used.}
{      The derivation of the minimum size requested from MultiFinder is described}
{      in Sample.h. The check should be made because the preferred size can end up}
{      being set smaller than the minimum size by the user. This extra check acts to}
 {     insure that your application is starting from a solid memory foundation.}

        if ORD(GetApplLimit) - ORD(ApplicZone) < kMinHeap then
            AlertUser;

    {Next, make sure that enough memory is free for your application to run. It}
{      is possible for a situation to arise where the heap may have been of required}
{      size, but a large scrap was loaded which left too little memory. To check for}
{      this, call PurgeSpace and compare the result with a value that you have determined}
{      is the minimum amount of free memory your application needs at initialization.}
{      This number can be derived several different ways. One way that is fairly}
{      straightforward is to run the application in the minimum size configuration}
{      as described previously. Call PurgeSpace at initialization and examine the value}
{      returned. However, you should make sure that this result is not being modified}
{      by the scrap's presence. You can do that by calling ZeroScrap before calling}
         {     PurgeSpace. Make sure to remove that call before shipping, though.}

        PurgeSpace(total, contig);
        if total < kMinSpace then
            AlertUser;

{The extra benefit to waitng until after the Toolbox Managers have been initialized}
{      before checking memory is that we can now give the user an alert to tell him what}
{      happened. Although it is possible that the memory situation could be worsened by}
{      displaying an alert, MultiFinder would gracefully exit the application with}
  {     an informative alert if memory became critical. Here we are acting more}
{      in a preventative manner to avoid future disaster from low-memory problems.}

        menuBar := GetNewMBar(rMenuBar); {read menus into menu bar}
        if menuBar = nil then
            AlertUser;
        SetMenuBar(menuBar); {install menus}
        DisposHandle(menuBar);
        AddResMenu(GetMHandle(mApple), 'DRVR'); {add DA names to Apple menu}
        DrawMenuBar;

{     InitializeApplication is a call to another unit (BigScrolling.p in this case).  This is}
{     here so you can put any application-specific code where it belongs instead of in the main }
{     program all the time.    }

        InitializeApplication; { give some other unit the chance to initialize}
{                                            itself }

    end; {Initialize}

    {$S Main}

procedure Terminate;

    {Clean up the application and exits. We close all of the windows so that}
    { they can update their documents, if any.}

    {1.01 - If we find out that a cancel has occurred, we won't exit to the}
    { shell, but will return instead.}

    var
        aWindow: WindowPtr;
        closed: BOOLEAN;

    begin
        closed := TRUE;
        repeat
            aWindow := FrontWindow; {get the current front window}
            if aWindow <> nil then
                closed := DoCloseWindow(aWindow); {close}
{                    this window}
        until (not closed) | (aWindow = nil); {do all windows}

{     TerminateApplication is a call to another unit (TrafficLights.p in the case of Sample).    This is}
{     here so you can put any application-specific code where it belongs instead of in the main }
            {     program all the time.    }

        TerminateApplication; { give some other unit the chance to kill itself}
{                                          }

        if closed then
            ExitToShell; {exit if no cancellation}
    end; {Terminate}

    {$S Main}

procedure AdjustMenus;

    {Enable and disable menus based on the current state.}
    { The user can only select enabled menu items. We set up all the menu items}
    { before calling MenuSelect or MenuKey, since these are the only times that}
    { a menu item can be selected. Note that MenuSelect is also the only time}
    { the user will see menu items. This approach to deciding what enable/}
{ disable state a menu item has the advantage of concentrating all the decision-}
{ making in one routine, as opposed to being spread throughout the application.}
{ Other application designs may take a different approach that may or may not be}
    { just as valid.}

{ 9/12/91, (MD) -- Added enabling and disabling page setup and print around DA windows. }

    var
        window: WindowPtr;
        menu: MenuHandle;

    begin
        window := FrontWindow;

        menu := GetMHandle(mEdit);
        if IsDAWindow(window) then
            begin {a desk accessory might need the edit}
{                                                         menu}
                EnableItem(menu, iUndo);
                EnableItem(menu, iCut);
                EnableItem(menu, iCopy);
                EnableItem(menu, iPaste);
                EnableItem(menu, iClear);
            end
        else
            begin {but we know we do not}
                DisableItem(menu, iUndo);
                DisableItem(menu, iCut);
                DisableItem(menu, iCopy);
                DisableItem(menu, iClear);
                DisableItem(menu, iPaste);
            end;

    end; {AdjustMenus}

    {$S Main}

procedure DoMenuCommand (menuResult: LongInt);

    {This is called when an item is chosen from the menu bar (after calling}
    { MenuSelect or MenuKey). It performs the right operation for each command.}
    { It is good to have both the result of MenuSelect and MenuKey go to}
    { one routine like this to keep everything organized.}

    var
        menuID: integer; {the ID of the selected menu}
        menuItem: integer; {the item number of the selected menu}
        itemHit: integer;
        daName, newFontName: Str255;
        daRefNum: integer;
        handledByDA: BOOLEAN;
        ignore: BOOLEAN;
        theWindow: windowPtr;     { for making a new window }

    begin
        menuID := HiWrd(menuResult); {use built-ins (for efficiency)...}
        menuItem := LoWrd(menuResult); {to get menu item number and menu}
{                                                      number}
        case menuID of
            mApple:
                case menuItem of
                    iAbout: {bring up alert for About}
                        itemHit := Alert(rAboutAlert, nil);
                    otherwise
                        begin {all non-About items in this menu are DAs}
                            GetItem(GetMHandle(mApple), menuItem, daName);
                            daRefNum := OpenDeskAcc(daName);
                        end;
                end;
            mFile:
                case menuItem of
                    iQuit:
                        Terminate;
                end;
            mEdit: {call SystemEdit for DA editing & MultiFinder}
                handledByDA := SystemEdit(menuItem - 1); {since we don't do any}
{                                                                            editing}
            otherwise
                ;        { The System takes care of Apple, Help and Application menus for us when we call}
{                                       MenuSelect, but it's good form to have all cases covered with a statement. }
        end;
        HiliteMenu(0); {unhighlight what MenuSelect (or MenuKey) hilited}
    end; {DoMenuCommand}

    {$S Main}

procedure DoUpdate (window: WindowPtr);

    {This is called when an update event is received for a window.}
    { It calls DrawWindow to draw the contents of an application window.}
    { As an effeciency measure that does not have to be followed, it}
    { calls the drawing routine only if the visRgn is non-empty. This}
    { will handle situations where calculations for drawing or drawing}
    { itself is very time-consuming.}

    begin
        if IsAppWindow(window) then
            begin
                BeginUpdate(window); {sets up the visRgn, clears updateRgn}
                if not EmptyRgn(window^.visRgn) then {draw if updating needs to be}
{                                                                  done}
                    DrawWindow(window, nil, FALSE, window = FrontWindow); {when we update,}
{                    we're not printing}
                EndUpdate(window); {restores the visRgn}
            end;
    end; {DoUpdate}

    {$S Main}

procedure DoActivate (window: WindowPtr; becomingActive: BOOLEAN);

    {This is called when a window is activated or deactivated.}
    { In Sample, the Window Manager's handling of activate and}
    { deactivate events is sufficient. Other applications may have}
    { TextEdit records, controls, lists, etc., to activate/deactivate.}

    begin
        if IsAppWindow(window) then
            DrawWindow(window, nil, FALSE, becomingActive);
    end; {DoActivate}

    {$S Main}

procedure GetGlobalMouse (var mouse: point);

    {Get the global coordinates of the mouse. When you call OSEventAvail}
    { it will return either a pending event or a null event. In either case,}
    { the where field of the event record will contain the current position}
    { of the mouse in global coordinates and the modifiers field will reflect}
    { the current state of the modifiers. Another way to get the global}
    { coordinates is to call GetMouse and LocalToGlobal, but that requires}
    { being sure that thePort is set to a valid port.}

    var
        event: EventRecord;

    begin
        if OSEventAvail(kNoEvents, event) then
            ; {we aren't interested in any}
{                                                                 events}
        mouse := event.where; {just the mouse position}
    end;

    {$S Main}

procedure AdjustCursor (mouse: point);

{Change the cursor's shape, depending on its position. This also calculates the region}
{ where the current cursor resides (for WaitNextEvent). If the mouse is ever outside of}
 { that region, an event is generated, causing this routine to be called. This}
  { allows us to change the region to the region the mouse is currently in. If}
{ there is more to the event than just “the mouse moved”, we get called before the}
{ event is processed to make sure the cursor is the right one. In any (ahem) event,}
    { this is called again before we fall back into WNE.}

    var
        window: WindowPtr;
        arrowRgn: RgnHandle;
        plusRgn: RgnHandle;
        globalContentRect: Rect;

        temp: handle;

    begin
        window := FrontWindow; {we only adjust the cursor when we are in}
{                                            front}
        if (not gInBackground) and (not IsDAWindow(window)) then
            begin
                {calculate regions for different cursor shapes}
                arrowRgn := NewRgn;
                plusRgn := NewRgn;

                {start with a big, big rectangular region}
                {1.01 - changed to kExtremeNeg and kExtremePos for consistency}
                SetRectRgn(arrowRgn, kExtremeNeg, kExtremeNeg, kExtremePos, kExtremePos);

                {calculate plusRgn}
{ In previous versions of Sample, this routine was significantly more complicated than}
{ it is now.  It used to create a rectangular region based on a window's portRect, intersect }
{it with the visRgn.  Since the visRgn is in local coordinates and the contentRgn is in global}
{coordinates, this used to be a fair amount of calculation.  All of which was unnecessary, }
{because:  a)  We only do this for our frontmost window, which is always completely visible}
{unless we have some kind of floating window in front of it, and b) we can't move the mouse}
{into any part of the content region that's not on-screen.}
{This routine now uses the contentRgn of the frontWindow for the plusRgn, exclusively.}

                if IsAppWindow(window) then
                    CopyRgn(WindowPeek(window)^.contRgn, plusRgn);

                {subtract other regions from arrowRgn}
                DiffRgn(arrowRgn, plusRgn, arrowRgn);

                {change the cursor and the region parameter}
                if PtInRgn(mouse, plusRgn) then
                    begin
                        SetCursor(GetCursor(plusCursor)^^);
                        CopyRgn(plusRgn, cursorRgn);
                    end
                else
                    begin
                        SetCursor(arrow);
                        CopyRgn(arrowRgn, cursorRgn);
                    end;

                {get rid of our local regions}
                DisposeRgn(arrowRgn);
                DisposeRgn(plusRgn);
            end;
    end; {AdjustCursor}

    {$S Main}

procedure DoEvent (event: EventRecord);

{Do the right thing for an event. Determine what kind of event it is, and call}
    { the appropriate routines.}

    var
        part, err: integer;
        window: WindowPtr;
        hit: BOOLEAN;
        key: CHAR;
        aPoint: point;

    begin
        case event.what of
            mouseDown:
                begin
                    part := FindWindow(event.where, window);
                    case part of
                        inDesk:
                            ;
                        inMenuBar:
                            begin {process the menu command}
                                AdjustMenus;
                                DoMenuCommand(MenuSelect(event.where));
                            end;
                        inSysWindow: {let the system handle the mouseDown}
                            SystemClick(event, window);
                        inContent:
                            if window <> FrontWindow then
                                begin
                                    SelectWindow(window);
                                {DoEvent(event);}
                                {use this line for "do first click"}
                                end
                            else
                                DoContentClick(window, event);
                        inDrag:
                            begin
                                {pass screenBits.bounds to get all gDevices}
                                DragWindow(window, event.where, screenBits.bounds);
                                AdjustCursor(event.where);
                            end;
                        inGrow:
                            ;
                        inZoomIn, inZoomOut:
                            ;
                    end;
                end;
            keyDown, autoKey:
                begin {check for menukey equivalents}
                    key := CHR(BAND(event.message, charCodeMask));
                    if BAND(event.modifiers, cmdKey) <> 0 then {Command key down}
                        if event.what = keyDown then
                            begin
                                AdjustMenus; {enable/disable/check menu items properly}
                                DoMenuCommand(MenuKey(key));
                            end;
                end; {call DoActivate with the window and...}
            activateEvt: {TRUE for activate, FALSE for deactivate}
                DoActivate(WindowPtr(event.message), BAND(event.modifiers, activeFlag) <> 0);
            updateEvt: {call DoUpdate with the window to update}
                DoUpdate(WindowPtr(event.message));
             {1.01 - It is not a bad idea to at least call DIBadMount in response}
                {            to a diskEvt, so that the user can format a floppy.}
            diskEvt:
                if HiWrd(event.message) <> noErr then
                    begin
                        SetPt(aPoint, kDILeft, kDITop);
                        err := DIBadMount(aPoint, event.message);
                    end;
            osEvt:
                case BAND(BRotL(event.message, 8), $FF) of {high byte of message}
                    SuspendResumeMessage:
                        begin
                            gInBackground := BAND(event.message, resumeFlag) = 0;
                            DoActivate(FrontWindow, not gInBackground);
                        end;
                    mouseMovedMessage:
                        AdjustCursor(event.where);
                end;
            otherwise
                ;
        end;
    end; {DoEvent}

    {$S Main}

procedure EventLoop;

    {Get events forever, and handle them by calling DoEvent.}
    { Get the events by calling WaitNextEvent, if it's available, otherwise}
 { by calling GetNextEvent. Also call AdjustCursor each time through the loop.}

    var
        gotEvent: BOOLEAN;
        event: EventRecord;
        mouse: point;

    begin
        cursorRgn := NewRgn;
        GetGlobalMouse(mouse);   { find the current mouse position }
        AdjustCursor(mouse);  { set up the cursor once }
        repeat
{put us 'asleep' forever under}
{                                                            MultiFinder}
            gotEvent := WaitNextEvent(everyEvent, event, MAXLONGINT, cursorRgn);

            if gotEvent then
                DoEvent(event);
                {If you are using modeless dialogs that have editText items,}
         {          you will want to call IsDialogEvent to give the caret a chance}
 {          to blink, even if WNE/GNE returned FALSE. However, check FrontWindow}
                {            for a non-NIL value before calling IsDialogEvent.}
        until FALSE; {loop forever; we quit through an ExitToShell}
    end; {EventLoop}

    {This routine is part of the MPW runtime library. This external}
    { reference to it is done so that we can unload its segment, %A5Init.}

    {$S Main}

begin

        {1.01 - call to ForceEnvirons removed}
        {If you have stack requirements that differ from the default,}
        {      then you could use SetApplLimit to increase StackSpace at }
        {      this point, before calling MaxApplZone.}

    MaxApplZone; {expand the heap so code segments load at the top}

    Initialize; {initialize the program}
    UnloadSeg(@Initialize); {note that Initialize must not be in Main!}

    EventLoop; {call the main event loop}
end.